Attribute VB_Name = "import_lines_dots_data_prompt"
Sub GetRGB(RGB As Long, ByRef Red As Integer, ByRef Green As Integer, ByRef Blue As Integer)
    Red = RGB And 255
    Green = RGB \ 256 And 255
    Blue = RGB \ 256 ^ 2 And 255
End Sub

Public Sub Import_dots_data_prompt()
    Dim FileName As String, r As Integer, b As Integer, g As Integer, dotsize As Double
    
    
    'If an error occurs(usually when Cancel is clicked)
    On Error GoTo ErrorH

    d_dot_file.Show

    FileName = d_dot_file.efile_name
    dotsize = CDbl(d_dot_file.e_symbol_size)
    GetRGB d_dot_file.b_color.BackColor, r, g, b
    Import_dots_data FileName, r, g, b, dotsize, d_dot_file.e_object_name
    Exit Sub
ErrorH:
    MsgBox "error here"
End Sub
Public Sub Import_lines_data_prompt()
    Dim FileName As String, r As Integer, b As Integer, g As Integer
    
    'If an error occurs(usually when Cancel is clicked)
    'On Error GoTo ErrorH

    d_lines_file.Show

    FileName = d_lines_file.efile_name
    GetRGB d_lines_file.b_color.BackColor, r, g, b
    Import_lines_data FileName, r, g, b, d_lines_file.e_object_name
    Exit Sub
ErrorH:
    MsgBox "error here"
End Sub
Sub Import_orthology_data()
    Dim FileName As String
    Import_dots_data "c:\1to1.txt", 255, 0, 0
    Import_dots_data "c:\1tom.txt", 0, 255, 0
    Import_dots_data "c:\mto1.txt", 0, 0, 255
    Import_dots_data "c:\mtom.txt", 0, 0, 0
End Sub

Sub Import_dots_data(FileName As String, r As Integer, g As Integer, b As Integer, ByVal dotsize As Double, name_ As String)
    Dim x As Double, y As Double
    dotsize = dotsize / 2
    
    Dim crv As Curve
    Set crv = CreateCurve(ActiveDocument)
    
    Dim sr As New ShapeRange
    ActiveDocument.Unit = cdrMillimeter
    Dim ap As Page
    Dim scale_x As Double
    Dim scale_y As Double
    ActivePage.GetSize scale_x, scale_y
    
    Dim sp As SubPath
    Dim fs, f, ts, str1, str2, str, pos
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(FileName)
    Set ts = f.OpenAsTextStream(1, -2)
    Do While ts.atendofstream <> True
        For a = 1 To 1000
            str = ts.ReadLine
            pos = InStr(1, str, Chr(9))
            x = Val(Left(str, pos)) * scale_x
            y = Val(Mid(str, pos + 1)) * scale_y
            
            Set sp = crv.CreateSubPath(x - dotsize, y - dotsize)
            sp.AppendLineSegment x + dotsize, y - dotsize, False
            sp.AppendLineSegment x + dotsize, y + dotsize, False
            sp.AppendLineSegment x - dotsize, y + dotsize, False
            sp.AppendLineSegment x - dotsize, y - dotsize, False
            sp.Closed = True
            If ts.atendofstream = True Then Exit For
        Next a
        Set s = ActiveLayer.CreateCurve(crv)
        s.Fill.UniformColor.RGBAssign r, g, b
        s.Outline.color.RGBAssign r, g, b
        s.Outline.Width = 0.0005
        If Len(name_) Then
            s.Name = name_
        End If
        sr.Add s
        Set crv = CreateCurve(ActiveDocument)
    Loop
    ts.Close
    
    sr.AddToSelection
    Application.ActiveSelection.group
    
    
    
End Sub

Sub Import_lines_data(FileName As String, r As Integer, g As Integer, b As Integer, name_ As String)
    Dim x1 As Double, y1 As Double
    Dim x2 As Double, y2 As Double
    
    Dim crv As Curve
    Set crv = CreateCurve(ActiveDocument)
    
    Dim sr As New ShapeRange
    
    Dim ap As Page
    Dim scale_x As Double
    Dim scale_y As Double
    ActivePage.GetSize scale_x, scale_y
    
    Dim sp As SubPath
    Dim fs, f, ts, str1, str2, str, pos
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(FileName)
    Set ts = f.OpenAsTextStream(1, -2)
    Do While ts.atendofstream <> True
        For a = 1 To 1000
            
            str = ts.ReadLine
            pos = InStr(1, str, Chr(9))
            x1 = Val(Left(str, pos)) * scale_x
            
            str = Mid(str, pos + 1)
            pos = InStr(1, str, Chr(9))
            y1 = Val(Left(str, pos)) * scale_y
            
            str = Mid(str, pos + 1)
            pos = InStr(1, str, Chr(9))
            x2 = Val(Left(str, pos)) * scale_x
            
            y2 = Val(Mid(str, pos + 1)) * scale_y
            Set sp = crv.CreateSubPath(x1, y1)
            sp.AppendLineSegment x2, y2, False
            'sp.Closed = True
            If ts.atendofstream = True Then Exit For
        Next a
        Set s = ActiveLayer.CreateCurve(crv)
        s.Fill.UniformColor.RGBAssign r, g, b
        s.Outline.color.RGBAssign r, g, b
        s.Outline.Width = 0.0005
        If Len(name_) Then
            s.Name = name_
        End If
        sr.Add s
        Set crv = CreateCurve(ActiveDocument)
    Loop
    ts.Close
    
    sr.AddToSelection
    Application.ActiveSelection.group
    
    
    
End Sub


